home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / src-server / xlisp / xlimage.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-10-04  |  11.0 KB  |  450 lines
  1. /* -*-C-*-
  2. ********************************************************************************
  3. *
  4. * File:         xlimage.c
  5. * RCS:          $Header: xlimage.c,v 1.7 91/03/24 22:24:52 mayer Exp $
  6. * Description:  xlisp memory image save/restore functions
  7. * Author:       David Michael Betz
  8. * Created:      
  9. * Modified:     Fri Oct  4 03:59:39 1991 (Niels Mayer) mayer@hplnpm
  10. * Language:     C
  11. * Package:      N/A
  12. * Status:       X11r5 contrib tape release
  13. *
  14. * WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. * XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. *
  17. * Permission to use, copy, modify, distribute, and sell this software and its
  18. * documentation for any purpose is hereby granted without fee, provided that
  19. * the above copyright notice appear in all copies and that both that
  20. * copyright notice and this permission notice appear in supporting
  21. * documentation, and that the name of Hewlett-Packard and David Betz not be
  22. * used in advertising or publicity pertaining to distribution of the software
  23. * without specific, written prior permission.  Hewlett-Packard and David Betz
  24. * make no representations about the suitability of this software for any
  25. * purpose. It is provided "as is" without express or implied warranty.
  26. *
  27. * HEWLETT-PACKARD AND DAVID BETZ DISCLAIM ALL WARRANTIES WITH REGARD TO THIS
  28. * SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS,
  29. * IN NO EVENT SHALL HEWLETT-PACKARD NOR DAVID BETZ BE LIABLE FOR ANY SPECIAL,
  30. * INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
  31. * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
  32. * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
  33. * PERFORMANCE OF THIS SOFTWARE.
  34. *
  35. * See ./winterp/COPYRIGHT for information on contacting the authors.
  36. * 
  37. * Please send modifications, improvements and bugfixes to mayer@hplabs.hp.com
  38. * Post XLISP-specific questions/information to the newsgroup comp.lang.lisp.x
  39. *
  40. ********************************************************************************
  41. */
  42. static char rcs_identity[] = "@(#)$Header: xlimage.c,v 1.7 91/03/24 22:24:52 mayer Exp $";
  43.  
  44.  
  45. #include "xlisp.h"
  46.  
  47. #ifdef SAVERESTORE
  48.  
  49. /* external variables */
  50. extern LVAL obarray,xlenv,xlfenv,xldenv,s_gchook,s_gcflag;
  51. extern long nnodes,nfree,total;
  52. extern int anodes,nsegs,gccalls;
  53. extern struct segment *segs,*lastseg,*fixseg,*charseg;
  54. extern CONTEXT *xlcontext;
  55. extern LVAL fnodes;
  56.  
  57. /* local variables */
  58. static OFFTYPE off,foff,doff;
  59. static FILE *fp;
  60.  
  61. /* external procedures */
  62. extern SEGMENT *newsegment();
  63. extern FILE *osbopen();
  64. extern char *malloc();
  65.  
  66. /* forward declarations */
  67. OFFTYPE readptr();
  68. OFFTYPE cvoptr();
  69. LVAL cviptr();
  70.  
  71. /* xlisave - save the memory image */
  72. int xlisave(fname)
  73.   char *fname;
  74. {
  75.     char fullname[STRMAX+1];
  76.     unsigned char *cp;
  77.     SEGMENT *seg;
  78.     int n,i,max;
  79.     LVAL p;
  80.  
  81.     /* default the extension */
  82.     if (needsextension(fname)) {
  83.     strcpy(fullname,fname);
  84.     strcat(fullname,".wks");
  85.     fname = fullname;
  86.     }
  87.  
  88.     /* open the output file */
  89.     if ((fp = osbopen(fname,"w")) == NULL)
  90.     return (FALSE);
  91.  
  92.     /* first call the garbage collector to clean up memory */
  93.     gc();
  94.  
  95.     /* write out the pointer to the *obarray* symbol */
  96.     writeptr(cvoptr(obarray));
  97.  
  98.     /* setup the initial file offsets */
  99.     off = foff = (OFFTYPE)2;
  100.  
  101.     /* write out all nodes that are still in use */
  102.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  103.     p = &seg->sg_nodes[0];
  104.     for (n = seg->sg_size; --n >= 0; ++p, off += 2)
  105.         switch (ntype(p)) {
  106.         case FREE:
  107.         break;
  108.         case CONS:
  109.         case USTREAM:
  110.         setoffset();
  111.         osbputc(p->n_type,fp);
  112.         writeptr(cvoptr(car(p)));
  113.         writeptr(cvoptr(cdr(p)));
  114.         foff += 2;
  115.         break;
  116.         default:
  117.         setoffset();
  118.         writenode(p);
  119.         break;
  120.         }
  121.     }
  122.  
  123.     /* write the terminator */
  124.     osbputc(FREE,fp);
  125.     writeptr((OFFTYPE)0);
  126.  
  127.     /* write out data portion of vector-like nodes */
  128.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  129.     p = &seg->sg_nodes[0];
  130.     for (n = seg->sg_size; --n >= 0; ++p)
  131.         switch (ntype(p)) {
  132.         case SYMBOL:
  133.         case OBJECT:
  134.         case VECTOR:
  135.         case CLOSURE:
  136.         case STRUCT:
  137. #ifdef WINTERP
  138.         case XLTYPE_TIMEOUTOBJ:
  139.         case XLTYPE_CALLBACKOBJ:
  140.         case XLTYPE_EVHANDLEROBJ:
  141.         case XLTYPE_PIXMAP_REFOBJ:
  142.         case XLTYPE_WIDGETOBJ:
  143. #endif
  144.         max = getsize(p);
  145.         for (i = 0; i < max; ++i)
  146.             writeptr(cvoptr(getelement(p,i)));
  147.         break;
  148.         case STRING:
  149.         max = getslength(p);
  150.         for (cp = getstring(p); --max >= 0; )
  151.             osbputc(*cp++,fp);
  152.         break;
  153.         }
  154.     }
  155.  
  156.     /* close the output file */
  157.     osclose(fp);
  158.  
  159.     /* return successfully */
  160.     return (TRUE);
  161. }
  162.  
  163. /* xlirestore - restore a saved memory image */
  164. int xlirestore(fname)
  165.   char *fname;
  166. {
  167.     extern FUNDEF funtab[];
  168.     char fullname[STRMAX+1];
  169.     unsigned char *cp;
  170.     int n,i,max,type;
  171.     SEGMENT *seg;
  172.     LVAL p;
  173.  
  174.     /* default the extension */
  175.     if (needsextension(fname)) {
  176.     strcpy(fullname,fname);
  177.     strcat(fullname,".wks");
  178.     fname = fullname;
  179.     }
  180.  
  181.     /* open the file */
  182.     if ((fp = osbopen(fname,"r")) == NULL)
  183.     return (FALSE);
  184.  
  185.     /* free the old memory image */
  186.     freeimage();
  187.  
  188.     /* initialize */
  189.     off = (OFFTYPE)2;
  190.     total = nnodes = nfree = 0L;
  191.     fnodes = NIL;
  192.     segs = lastseg = NULL;
  193.     nsegs = gccalls = 0;
  194.     xlenv = xlfenv = xldenv = s_gchook = s_gcflag = NIL;
  195.     xlstack = xlstkbase + EDEPTH;
  196.     xlcontext = NULL;
  197.  
  198.     /* create the fixnum segment */
  199.     if ((fixseg = newsegment(SFIXSIZE)) == NULL)
  200.     xlfatal("insufficient memory - fixnum segment");
  201.  
  202.     /* create the character segment */
  203.     if ((charseg = newsegment(CHARSIZE)) == NULL)
  204.     xlfatal("insufficient memory - character segment");
  205.  
  206.     /* read the pointer to the *obarray* symbol */
  207.     obarray = cviptr(readptr());
  208.  
  209.     /* read each node */
  210.     while ((type = osbgetc(fp)) >= 0)
  211.     switch (type) {
  212.     case FREE:
  213.         if ((off = readptr()) == (OFFTYPE)0)
  214.         goto done;
  215.         break;
  216.     case CONS:
  217.     case USTREAM:
  218.         p = cviptr(off);
  219.         p->n_type = type;
  220.         p->n_flags = 0;
  221.         rplaca(p,cviptr(readptr()));
  222.         rplacd(p,cviptr(readptr()));
  223.         off += 2;
  224.         break;
  225.     default:
  226.         readnode(type,cviptr(off));
  227.         off += 2;
  228.         break;
  229.     }
  230. done:
  231.  
  232.     /* read the data portion of vector-like nodes */
  233.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  234.     p = &seg->sg_nodes[0];
  235.     for (n = seg->sg_size; --n >= 0; ++p)
  236.         switch (ntype(p)) {
  237.         case SYMBOL:
  238.         case OBJECT:
  239.         case VECTOR:
  240.         case CLOSURE:
  241.         case STRUCT:
  242. #ifdef WINTERP
  243.         case XLTYPE_TIMEOUTOBJ:
  244.         case XLTYPE_CALLBACKOBJ:
  245.             case XLTYPE_PIXMAP_REFOBJ:
  246.         case XLTYPE_WIDGETOBJ:
  247.         case XLTYPE_EVHANDLEROBJ:
  248. #endif
  249.         max = getsize(p);
  250.         if ((p->n_vdata = (LVAL *)malloc(max * sizeof(LVAL))) == NULL)
  251.             xlfatal("insufficient memory - vector");
  252.         total += (long)(max * sizeof(LVAL));
  253.         for (i = 0; i < max; ++i)
  254.             setelement(p,i,cviptr(readptr()));
  255.         break;
  256.         case STRING:
  257.         max = getslength(p);
  258.         if ((p->n_string = (unsigned char *)malloc(max)) == NULL)
  259.             xlfatal("insufficient memory - string");
  260.         total += (long)max;
  261.         for (cp = getstring(p); --max >= 0; )
  262.             *cp++ = osbgetc(fp);
  263.         break;
  264.         case STREAM:
  265. #if (defined(UNIX) || defined(WINTERP))
  266.         case XLTYPE_PIPE:
  267. #endif /* (defined(UNIX) || defined(WINTERP)) */
  268.         setfile(p,NULL);
  269.         break;
  270.         case SUBR:
  271.         case FSUBR:
  272.         p->n_subr = funtab[getoffset(p)].fd_subr;
  273.         break;
  274.         }
  275.     }
  276.  
  277.     /* close the input file */
  278.     osclose(fp);
  279.  
  280.     /* collect to initialize the free space */
  281.     gc();
  282.  
  283.     /* lookup all of the symbols the interpreter uses */
  284.     xlsymbols();
  285.  
  286.     /* return successfully */
  287.     return (TRUE);
  288. }
  289.  
  290. /* freeimage - free the current memory image */
  291. LOCAL freeimage()
  292. {
  293.     SEGMENT *seg,*next;
  294.     FILE *fp;
  295.     LVAL p;
  296.     int n;
  297.  
  298.     /* free the data portion of vector-like nodes */
  299.     for (seg = segs; seg != NULL; seg = next) {
  300.     p = &seg->sg_nodes[0];
  301.     for (n = seg->sg_size; --n >= 0; ++p)
  302.         switch (ntype(p)) {
  303.         case SYMBOL:
  304.         case OBJECT:
  305.         case VECTOR:
  306.         case CLOSURE:
  307.         case STRUCT:
  308. #ifdef WINTERP
  309.         case XLTYPE_TIMEOUTOBJ:
  310.         case XLTYPE_CALLBACKOBJ:
  311.             case XLTYPE_PIXMAP_REFOBJ:
  312.         case XLTYPE_WIDGETOBJ:
  313.         case XLTYPE_EVHANDLEROBJ:
  314. #endif
  315.         if (p->n_vsize)
  316.             free(p->n_vdata);
  317.         break;
  318.         case STRING:
  319.         if (getslength(p))
  320.             free(getstring(p));
  321.         break;
  322.         case STREAM:
  323.         if ((fp = getfile(p)) && (fp != stdin && fp != stdout && fp != stderr))
  324.             osclose(getfile(p));
  325.         break;
  326. #if (defined(UNIX) || defined(WINTERP))
  327.         case XLTYPE_PIPE:
  328.         if (fp = getfile(p))
  329.             pclose(getfile(p));
  330.         break;
  331. #endif /* (defined(UNIX) || defined(WINTERP)) */
  332.         }
  333.     next = seg->sg_next;
  334.     free(seg);
  335.     }
  336. }
  337.  
  338. /* setoffset - output a positioning command if nodes have been skipped */
  339. LOCAL setoffset()
  340. {
  341.     if (off != foff) {
  342.     osbputc(FREE,fp);
  343.     writeptr(off);
  344.     foff = off;
  345.     }
  346. }
  347.  
  348. /* writenode - write a node to a file */
  349. LOCAL writenode(node)
  350.   LVAL node;
  351. {
  352.     char *p = (char *)&node->n_info;
  353.     int n = sizeof(union ninfo);
  354.     osbputc(node->n_type,fp);
  355.     while (--n >= 0)
  356.     osbputc(*p++,fp);
  357.     foff += 2;
  358. }
  359.  
  360. /* writeptr - write a pointer to a file */
  361. LOCAL writeptr(off)
  362.   OFFTYPE off;
  363. {
  364.     char *p = (char *)&off;
  365.     int n = sizeof(OFFTYPE);
  366.     while (--n >= 0)
  367.     osbputc(*p++,fp);
  368. }
  369.  
  370. /* readnode - read a node */
  371. LOCAL readnode(type,node)
  372.   int type; LVAL node;
  373. {
  374.     char *p = (char *)&node->n_info;
  375.     int n = sizeof(union ninfo);
  376.     node->n_type = type;
  377.     node->n_flags = 0;
  378.     while (--n >= 0)
  379.     *p++ = osbgetc(fp);
  380. }
  381.  
  382. /* readptr - read a pointer */
  383. LOCAL OFFTYPE readptr()
  384. {
  385.     OFFTYPE off;
  386.     char *p = (char *)&off;
  387.     int n = sizeof(OFFTYPE);
  388.     while (--n >= 0)
  389.     *p++ = osbgetc(fp);
  390.     return (off);
  391. }
  392.  
  393. /* cviptr - convert a pointer on input */
  394. LOCAL LVAL cviptr(o)
  395.   OFFTYPE o;
  396. {
  397.     OFFTYPE off = (OFFTYPE)2;
  398.     SEGMENT *seg;
  399.  
  400.     /* check for nil */
  401.     if (o == (OFFTYPE)0)
  402.     return ((LVAL)o);
  403.  
  404.     /* compute a pointer for this offset */
  405.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  406.     if (o >= off && o < off + (OFFTYPE)(seg->sg_size << 1))
  407.         return (seg->sg_nodes + ((int)(o - off) >> 1));
  408.     off += (OFFTYPE)(seg->sg_size << 1);
  409.     }
  410.  
  411.     /* create new segments if necessary */
  412.     for (;;) {
  413.  
  414.     /* create the next segment */
  415.     if ((seg = newsegment(anodes)) == NULL)
  416.         xlfatal("insufficient memory - segment");
  417.  
  418.     /* check to see if the offset is in this segment */
  419.     if (o >= off && o < off + (OFFTYPE)(seg->sg_size << 1))
  420.         return (seg->sg_nodes + ((int)(o - off) >> 1));
  421.     off += (OFFTYPE)(seg->sg_size << 1);
  422.     }
  423. }
  424.  
  425. /* cvoptr - convert a pointer on output */
  426. LOCAL OFFTYPE cvoptr(p)
  427.   LVAL p;
  428. {
  429.     OFFTYPE off = (OFFTYPE)2;
  430.     SEGMENT *seg;
  431.  
  432.     /* check for nil and small fixnums */
  433.     if (p == NIL)
  434.     return ((OFFTYPE)p);
  435.  
  436.     /* compute an offset for this pointer */
  437.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  438.     if (CVPTR(p) >= CVPTR(&seg->sg_nodes[0]) &&
  439.         CVPTR(p) <  CVPTR(&seg->sg_nodes[0] + seg->sg_size))
  440.         return (off + (OFFTYPE)((p - seg->sg_nodes) << 1));
  441.     off += (OFFTYPE)(seg->sg_size << 1);
  442.     }
  443.  
  444.     /* pointer not within any segment */
  445.     xlerror("bad pointer found during image save",p);
  446. }
  447.  
  448. #endif
  449.  
  450.